home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue65 / alfresco / SpaceRemU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-11-28  |  4.5 KB  |  179 lines
  1. {*********************************************************}
  2. {* SpaceRemU                                             *}
  3. {* Copyright (c) Julian M Bucknall 2001                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco: Removing spaces with DFA         *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit SpaceRemU;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  19.   StdCtrls;
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     Button1: TButton;
  24.     Edit1: TEdit;
  25.     Label1: TLabel;
  26.     Label2: TLabel;
  27.     procedure Edit1Change(Sender: TObject);
  28.     procedure Button1Click(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. function aaRemoveSpaces1(const S : string) : string;
  43. var
  44.   Inx       : integer;
  45.   State     : (ScanningNormal, ScanningQuoted, ScanningSpaces);
  46.   ResultLen : integer;
  47.   Ch        : char;
  48. begin
  49.   if S = '' then begin
  50.     Result := '';
  51.     Exit;
  52.   end;
  53.   SetLength(Result, length(S));
  54.   ResultLen := 0;
  55.   State := ScanningNormal;
  56.   for Inx := 1 to length(S) do begin
  57.     Ch := S[Inx];
  58.     case State of
  59.       ScanningNormal :
  60.         begin
  61.           inc(ResultLen);
  62.           Result[ResultLen] := Ch;
  63.           if (Ch = ' ') then
  64.             State := ScanningSpaces
  65.           else if (Ch = '"') then
  66.             State := ScanningQuoted;
  67.         end;
  68.       ScanningQuoted :
  69.         begin
  70.           inc(ResultLen);
  71.           Result[ResultLen] := Ch;
  72.           if (Ch = '"') then
  73.             State := ScanningNormal;
  74.         end;
  75.       ScanningSpaces :
  76.         begin
  77.           if (Ch <> ' ') then begin
  78.             inc(ResultLen);
  79.             Result[ResultLen] := Ch;
  80.             if (Ch = '"') then
  81.               State := ScanningQuoted
  82.             else
  83.               State := ScanningNormal;
  84.           end;
  85.         end;
  86.     end;
  87.   end;
  88.   if (State = ScanningQuoted) then begin
  89.     Result := '';
  90.     raise Exception.Create('Unbalanced quotes in input string');
  91.   end
  92.   else
  93.     SetLength(Result, ResultLen);
  94. end;
  95.  
  96. function aaRemoveSpaces2(const S : string) : string;
  97. var
  98.   Inx       : integer;
  99.   State     : (ScanningLeadSpaces, ScanningNormal,
  100.                ScanningQuoted, ScanningSpaces);
  101.   ResultLen : integer;
  102.   Ch        : char;
  103. begin
  104.   if S = '' then begin
  105.     Result := '';
  106.     Exit;
  107.   end;
  108.   SetLength(Result, length(S));
  109.   ResultLen := 0;
  110.   State := ScanningLeadSpaces;
  111.   for Inx := 1 to length(S) do begin
  112.     Ch := S[Inx];
  113.     case State of
  114.       ScanningLeadSpaces :
  115.         begin
  116.           if (Ch <> ' ') then begin
  117.             inc(ResultLen);
  118.             Result[ResultLen] := Ch;
  119.             if (Ch = '"') then
  120.               State := ScanningQuoted
  121.             else
  122.               State := ScanningNormal;
  123.           end;
  124.         end;
  125.       ScanningNormal :
  126.         begin
  127.           if (Ch = ' ') then
  128.             State := ScanningSpaces
  129.           else begin
  130.             inc(ResultLen);
  131.             Result[ResultLen] := Ch;
  132.             if (Ch = '"') then
  133.               State := ScanningQuoted;
  134.           end;
  135.         end;
  136.       ScanningQuoted :
  137.         begin
  138.           inc(ResultLen);
  139.           Result[ResultLen] := Ch;
  140.           if (Ch = '"') then
  141.             State := ScanningNormal;
  142.         end;
  143.       ScanningSpaces :
  144.         begin
  145.           if (Ch <> ' ') then begin
  146.             inc(ResultLen);
  147.             Result[ResultLen] := ' ';
  148.             inc(ResultLen);
  149.             Result[ResultLen] := Ch;
  150.             if (Ch = '"') then
  151.               State := ScanningQuoted
  152.             else
  153.               State := ScanningNormal;
  154.           end;
  155.         end;
  156.     end;
  157.   end;
  158.   if (State = ScanningQuoted) then begin
  159.     Result := '';
  160.     raise Exception.Create('Unbalanced quotes in input string');
  161.   end
  162.   else
  163.     SetLength(Result, ResultLen);
  164. end;
  165.  
  166. procedure TForm1.Edit1Change(Sender: TObject);
  167. begin
  168.   Label1.Caption := '';
  169.   Label2.Caption := '';
  170. end;
  171.  
  172. procedure TForm1.Button1Click(Sender: TObject);
  173. begin
  174.   Label1.Caption := '[' + aaRemoveSpaces1(Edit1.Text) + ']';
  175.   Label2.Caption := '[' + aaRemoveSpaces2(Edit1.Text) + ']';
  176. end;
  177.  
  178. end.
  179.